home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / pas_0593.zip / PALETTE-.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-30  |  3KB  |  82 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 227 of 288                                                               
  3. From : William Sitch                       1:163/542.0          29 May 93  11:16 
  4. To   : Chris Lukic                         1:271/29.0                            
  5. Subj : Problems working with TP60...                                          
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Quoting [From: Chris Lukic; To: William Sitch]
  8.  
  9. CL> I'm not sure where this code came from, but I'd be willing
  10. CL> to bet  it will be great deal of help.
  11.  
  12. Unfortunately not... <grin>.. I've already written something a bit different,
  13. but it gets the job done.  Except the procedure rotatepalette.. which looks
  14. neat...
  15.  
  16. CL>  Procedure RotatePalette(var p:Paletetype;n1,n2,d:Integer);
  17. CL>  
  18. CL>   procedure rotatePalette(var p:Paletetype;n1,n2,d:integer);
  19. CL>                           var q: PaleteType;
  20. CL>   begin { procedure rotatePalette }
  21. CL>     q:=p;
  22. CL>     for i:=n1 to n2 do
  23. CL>       p[i]:=q[n1+(i+d) mod (n2-n1+1)];
  24. CL>    palette(p);
  25. CL>   end; { procedure rotatePalette }
  26.  
  27. Although I can't see offhand what it really does ... <grin>... Here's my (rather
  28. long) but nice palette fading routines...
  29.  
  30. ---}
  31. procedure workpalette (num:byte; out,nice:boolean);
  32. const
  33.   numpal  = 5;
  34.   maxcol  = 255;
  35.   palinfo : array [1..numpal,0..maxcol,1..3] of byte =
  36.             ** info removed **
  37. var
  38.   i, j  :  byte;
  39.   regs  :  registers;
  40. begin
  41.   if (out = true) then
  42.     if (nice = true) then
  43.       for i := 1 to 255 do
  44.         for j := 255 downto i do
  45.           begin
  46.             port[$3C8] := j;
  47.             port[$3C9] := palinfo[num,j-i,1] shr 2;
  48.             port[$3C9] := palinfo[num,j-i,2] shr 2;
  49.             port[$3C9] := palinfo[num,j-i,3] shr 2;
  50.           end;
  51.       end
  52.     else if (nice = false) then
  53.       for i := 1 to 255 do
  54.         begin
  55.           port[$3C8] := i;
  56.           port[$3C9] := 0;
  57.           port[$3C9] := 0;
  58.           port[$3C9] := 0;
  59.         end
  60.   else if (out = false) then
  61.     if (nice = true) then
  62.       begin
  63.         workpalette(0,true,false);
  64.         for i := 255 downto 1 do
  65.           for j := i to 255 do
  66.             begin
  67.               port[$3C8] := j;
  68.               port[$3C9] := palinfo[num,j-i,1] shr 2;
  69.               port[$3C9] := palinfo[num,j-i,2] shr 2;
  70.               port[$3C9] := palinfo[num,j-i,3] shr 2;
  71.             end;
  72.       end
  73.     else
  74.       for i := 1 to 255 do
  75.         begin
  76.           port[$3C8] := i;
  77.           port[$3C9] := palinfo[num,i,1] shr 2;
  78.           port[$3C9] := palinfo[num,i,2] shr 2;
  79.           port[$3C9] := palinfo[num,i,3] shr 2;
  80.         end;
  81. end;
  82.